unit FiagADO;

interface

uses Classes, DBGrids;

function ExtractUserId(AConnStr: string): string;
function GetTableNames(const AConnStr: string; const AOwner: string = ''):
  TStrings;
procedure BestWidthDBGrid(ADBGrid: TDBGrid);
function GetPrimaryKeys(const AConnStr, ATableName: string): TStrings;
function GetOwners(const AConnStr: string): TStrings;
function GetProcedureNames(const AConnStr, AOwner: string): TStrings;
function GetTableColumns(const AConnStr, AOwner, ATableName: string):TStrings;

implementation

uses DB, ADODB, Variants, SysUtils, StrUtils;

function ExtractUserId(AConnStr: string): string;
var
  tmp: TStringList;
  tmpStr: string;
  I, iCount, iPos: Integer;
begin
  tmp := TStringList.Create;
  tmp.Text := AnsiReplaceStr(AConnStr, ';', #13#10);
  //  codesite.Send('AConnStr',AConnStr);

  iCount := tmp.Count - 1;
  for I := 0 to iCount do
  begin
    tmpStr := tmp.Strings[I];
    //    codesite.Send('tmpStr',tmpStr);
    if AnsiContainsText(tmpStr, 'User ID') then
    begin
      iPos := AnsiPos('=', tmpStr);
      if iPos > 0 then
        Result := Trim(Copy(tmpStr, iPos + 1, MaxInt));
    end;
  end;
  //  codesite.Send(Result);
  tmp.Free;
end;

{ --Function

 Get table names list by connection string and owner(table_schema);

 --Parameters
 AConnStr MUST Exist.
 if not include password in AConnStr, please set ALoginPrompt:=True
 if AOwner is missing or null string, then return all tables name;

 --Known Issus
 Couldnot judge dropped tables.

 --Example Codes:
var
  tmp:TStrings;
begin
  tmp:=GetTableNames(conMain.ConnectionString,'ncs');
  if tmp<>nil then
    cbbTableNames.Items.Assign(tmp);
  tmp.Clear;
end;
}

function GetTableNames(const AConnStr, AOwner: string): TStrings;
const
//  SDefaultFilter = '(TABLE_TYPE = ''TABLE'')';
//  SFilterSchema = ' AND (TABLE_SCHEMA = ''%s'')';
  STABLE_NAME = 'TABLE_NAME';
  SASC = ' ASC';
var
  adoConn: TADOConnection;
  adoDS: TADODataSet;
  AField: TField;
  Restric: OleVariant;
begin
  Result := nil;
  adoConn := TADOConnection.Create(nil);
  adoDS := TADODataSet.Create(nil);

  adoConn.ConnectionString := AConnStr;
  adoConn.LoginPrompt := False;
  try
    {
    TABLE_CATALOG
    TABLE_SCHEMA
    TABLE_NAME
    TABLE_TYPE
    }
    Restric:=VarArrayCreate([0,3],varVariant);
    Restric[1]:=UpperCase(AOwner);
    Restric[3]:='TABLE';
    
    adoConn.OpenSchema(siTables, Restric, EmptyParam, adoDS);

    with adoDS do
      if Active then
      begin
//        Filter := SDefaultFilter;
//        if AOwner <> '' then
//          Filter := Filter + Format(SFilterSchema, [UpperCase(AOwner)]);
        Sort := STABLE_NAME + SASC;
//        Filtered := True;
        AField := FindField(STABLE_NAME);

        Result := TStringList.Create;
        First;
        while not Eof do
        begin
          Result.Add(AField.AsString);
          Next;
        end;
      end;
  except
    //    on E: Exception do
    //      MessageDlg(SMsgConnectError + E.Message, mtInformation, [mbOK], 0);
  end;
  adoConn.Free;
  adoDS.Free;
end;

procedure BestWidthDBGrid(ADBGrid: TDBGrid);
var
  I, J, iCount, iWidth, BestWidth: Integer;
  AField: TField;
  strTemp: string;
begin
  if not Assigned(ADBGrid) then
    Exit;

  iCount := ADBGrid.FieldCount;
  for I := 0 to iCount - 1 do
  begin
    with ADBGrid.DataSource.DataSet do
    begin
      DisableControls;
      J := RecNo;
      AField := ADBGrid.Fields[I];
      BestWidth := 0;
      First;
      while not Eof do
      begin
        strTemp := AField.AsString;
        iWidth := ADBGrid.Canvas.TextWidth(Trim(strTemp));
        if BestWidth < iWidth then
          BestWidth := iWidth;
        Next;
      end;
      RecNo := J;
      EnableControls;
    end;
    iWidth := ADBGrid.Canvas.TextWidth(ADBGrid.Columns.Items[I].DisplayName);
    if BestWidth < iWidth then
      BestWidth := iWidth;
    Inc(BestWidth, 4);
    ADBGrid.Columns.Items[I].Width := BestWidth;
  end;
end;

function GetPrimaryKeys(const AConnStr, ATableName: string): TStrings;
const
  SSORT = 'ORDINAL ASC';
  SFLITER = 'TABLE_NAME=''%s''';
  SFIELD_NAME = 'COLUMN_NAME';
var
  adoConn: TADOConnection;
  adoDS: TADODataSet;
  AField: TField;
  Restric: OleVariant;
begin
  Result := nil;
  adoConn := TADOConnection.Create(nil);
  adoDS := TADODataSet.Create(nil);

  adoConn.ConnectionString := AConnStr;
  adoConn.LoginPrompt := False;
  try
    {
    PK_TABLE_CATALOG 0
    PK_TABLE_SCHEMA  1
    PK_TABLE_NAME    2
    }
    Restric:=VarArrayCreate([0,2],varVariant);
    Restric[2]:=UpperCase(ATableName);
    
    adoConn.OpenSchema(siPrimaryKeys, Restric, EmptyParam, adoDS);
    with adoDS do
      if Active then
      begin
        Sort := SSORT;
//        Filter := Format(SFLITER, [UpperCase(ATableName)]);
//        Filtered := True;
        AField := FindField(SFIELD_NAME);

        Result := TStringList.Create;
        First;
        while not Eof do
        begin
          Result.Add(AField.AsString);
          Next;
        end;
      end;
  except
//    on E: Exception do
//      Result.Add(SMsgConnectError + E.Message);
  end;

  adoConn.Free;
  adoDS.Free;
end;

function GetOwners(const AConnStr: string): TStrings;
const
  SFIELD_NAME = 'SCHEMA_NAME';
  SASC = ' ASC';
var
  adoConnA: TADOConnection;
  adoDSA: TADODataSet;
  AField: TField;
begin
  Result := nil;
  if AConnStr = '' then
    Exit;
  adoConnA := TADOConnection.Create(nil);
  adoDSA := TADODataSet.Create(nil);

  adoConnA.ConnectionString := AConnStr;
  adoConnA.LoginPrompt := False;

  try
    {
    CATALOG_NAME
    SCHEMA_NAME
    SCHEMA_OWNER
    }
    adoConnA.OpenSchema(siSchemata, EmptyParam, EmptyParam, adoDSA);
    with adoDSA do
      if Active then
      begin
        Sort := SFIELD_NAME + SASC;
        AField := FindField(SFIELD_NAME);
        Result := TStringList.Create;
        First;
        while not Eof do
        begin
          Result.Add(AField.AsString);
          Next;
        end;
      end;
  except
    on E: Exception do
//      Result.Add(SMsgConnectError + E.Message);
    //      MessageDlg(SMsgConnectError + E.Message, mtInformation, [mbOK], 0);
  end;
  adoConnA.Free;
  adoDSA.Free;
end;

{--Function
  GetProcedureNames

 --Example Codes
var
  tmp:TStrings;
begin
  tmp:=GetProcedureNames(adoConn.ConnectionString,'ncs');
  if tmp<>nil then
    cbbTableNames.Items.Assign(tmp);
  tmp.Clear;
end;
 }

function GetProcedureNames(const AConnStr, AOwner: string): TStrings;
const
  SFilterSchema = 'PROCEDURE_SCHEMA=''%s''';
  SFIELD_NAME = 'PROCEDURE_NAME';
  SASC = ' ASC';
var
  adoConnA: TADOConnection;
  adoDSA: TADODataSet;
  AField: TField;
  Restriction: OleVariant;
begin
  Result := nil;
  if AConnStr = '' then
    Exit;

  adoConnA := TADOConnection.Create(nil);
  adoDSA := TADODataSet.Create(nil);

  adoConnA.ConnectionString := AConnStr;
  adoConnA.LoginPrompt := False;

  try
    {
    PROCEDURE_CATALOG
    PROCEDURE_SCHEMA
    PROCEDURE_NAME
    PROCEDURE_TYPE
    }
    Restriction:=VarArrayCreate([0,3], varVariant);
    Restriction[1] := UpperCase(AOwner);
    
    adoConnA.OpenSchema(siProcedures, Restriction, EmptyParam, adoDSA);
    with adoDSA do
      if Active then
      begin
//        if AOwner <> '' then
//        begin
//          Filter := Format(SFilterSchema, [UpperCase(AOwner)]);
//          Filtered := True;
//        end;
        Sort := SFIELD_NAME + SASC;
        AField := FindField(SFIELD_NAME);
        Result := TStringList.Create;
        First;
        while not Eof do
        begin
          Result.Add(AField.AsString);
          Next;
        end;
      end;
  except
    on E: Exception do
//      Result.Add(SMsgConnectError + E.Message);
    //      MessageDlg(SMsgConnectError + E.Message, mtInformation, [mbOK], 0);
  end;
  adoConnA.Free;
  adoDSA.Free;
end;

function GetTableColumns(const AConnStr, AOwner, ATableName: string):TStrings;
const
  SSORT = 'COLUMN_NAME ASC';
  SFIELD_NAME = 'COLUMN_NAME';
var
  adoConn: TADOConnection;
  adoDS: TADODataSet;
  AField: TField;
  Restric: OleVariant;
begin
  Result := nil;
  adoConn := TADOConnection.Create(nil);
  adoDS := TADODataSet.Create(nil);

  adoConn.ConnectionString := AConnStr;
  adoConn.LoginPrompt := False;
  try
    {    
    TABLE_CATALOG
    TABLE_SCHEMA
    TABLE_NAME
    COLUMN_NAME
    }
    Restric:=VarArrayCreate([0,3], varVariant);
    Restric[1] := 'NCS';
    Restric[2] := 'T_MENULOG';

    adoConn.OpenSchema(siColumns, Restric, EmptyParam, adoDS);
    with adoDS do
      if Active then
      begin
        Sort := SSORT;
        AField := FindField(SFIELD_NAME);

        Result := TStringList.Create;
        First;
        while not Eof do
        begin
          Result.Add(AField.AsString);
          Next;
        end;
      end;
  except
    //    on E: Exception do
    //      Result.Add(SMsgConnectError + E.Message);
  end;
  adoDS.Close;
  adoDS.Free;
  adoConn.Close;
  adoConn.Free;
end;

end.

